home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Amiga-E
/
E_v3.2a
/
Src
/
Gfx
/
nice.e
< prev
next >
Wrap
Text File
|
1994-11-08
|
5KB
|
197 lines
/* Evolutionary "nice" pictures.
breed bitmaps. A fitness function will assign numbers according to
all sorts of perception criteria. mutation, the usual.
possible "niceness" criteria:
- amount of surrounding pixels having a similar color -> smoothness
- amount of different colors used in total -> diversity
- longer stretching lines (hard to detect)
- symmetry / repetition / parallelism
- find longest path (fill-alg)
*/
OPT OSVERSION=37, PREPROCESS, REG=5
-> fixed parameters
DEF bmx=10,bmy=30, -> bitmap size
bmnum=3, -> #of bitmaps to breed at once
evrate=2, -> kill/birth rate of evolution. <bmnum
nummut=1, -> number of mutations each time
numrate=100 -> how many to rate
#define MIRROR
DEF bmt, -> total bytes per bitmap
hinum=0, -> best sofar
bmp=NIL:PTR TO LONG,
bmscore=NIL:PTR TO LONG,
bmcalc=NIL:PTR TO CHAR
MODULE 'tools/easygui', 'tools/exceptions', 'tools/clonescreen',
'intuition/screens'
DEF scr=NIL:PTR TO screen,font
DEF fmt,keepshowing=TRUE,iterations
PROC main() HANDLE
DEF r
fmt:='%2ld'
LOOP
r:=easygui('Nice Pix',
[EQROWS,
[SLIDE,{setbmx},'bitmap x size: ',FALSE,3,99,bmx,10,fmt],
[SLIDE,{setbmy},'bitmap y size: ',FALSE,3,99,bmy,10,fmt],
[SLIDE,{setbmn},'#of bitmaps: ',FALSE,2,99,bmnum,10,fmt],
[SLIDE,{setevr},'kill/birth: ',FALSE,1,99,evrate,10,fmt],
[SLIDE,{setmut},'mutations: ',FALSE,1,99,nummut,10,fmt],
[SLIDE,{setrat},'rating: ',FALSE,1,999,numrate,10,fmt],
[BAR],
[COLS,[BUTTON,1,'Start'],[SPACEH],[BUTTON,0,'Cancel']]
]
)
evrate:=Bounds(evrate,1,bmnum-1)
IF r=0 THEN Raise()
actionreq()
ENDLOOP
EXCEPT
IF scr THEN closeclonescreen(scr,font)
report_exception()
ENDPROC
PROC setbmx(i,n) IS bmx:=n
PROC setbmy(i,n) IS bmy:=n
PROC setbmn(i,n) IS bmnum:=n
PROC setevr(i,n) IS evrate:=n
PROC setmut(i,n) IS nummut:=n
PROC setrat(i,n) IS numrate:=n
PROC actionreq() HANDLE
DEF gh=NIL:PTR TO guihandle,res=-1,count=0,a
gh:=guiinit('Nice Pix Action: BUSY',
[EQROWS,
[CHECK,{togglekeep},'keep showing picture:',keepshowing,TRUE],
[SLIDE,{setw1},'weight: ',FALSE,0,99,50,10,fmt],
[BAR],
[COLS,[BUTTON,{showpic},'Show Picture'],[SPACEH],[BUTTON,0,'Stop']]
]
)
setupsim()
IF scr THEN SetRast(scr.rastport,0)
WHILE res<0
->Wait(gh.sig)
res:=guimessage(gh)
FOR a:=1 TO 3 DO dosim()
IF keepshowing THEN IF count++ AND $F = 0 THEN showpic(0)
ENDWHILE
EXCEPT DO
deallocsim()
cleangui(gh)
IF exception THEN ReThrow()
ENDPROC res
PROC setw1(i,n) IS n
PROC togglekeep(i,n) IS keepshowing:=n
CONST XO=40,YO=40,XZ=2,YZ=2,COL=16,DEPTH=4
CONST XO1=XO+XZ-1,YO1=YO+YZ-1,XZ2=XZ*2,YZ2=YZ*2
PROC showpic(i)
DEF x,y,bm
bm:=bmp[hinum]
IF scr=NIL
scr,font:=openclonescreen('Workbench','Nice!',DEPTH)
ENDIF
SetStdRast(scr.rastport)
Colour(2,0)
TextF(XO,YO-10,'hi = \d, it = \d ',bmscore[hinum],iterations)
FOR y:=YZ TO bmy*YZ STEP YZ
FOR x:=XZ TO bmx*XZ STEP XZ
#ifdef MIRROR
Box(bmx*XZ2-x+XO,y+YO,bmx*XZ2-x+XO1,y+YO1,bm[])
Box(bmx*XZ2-x+XO,bmy*YZ2-y+YO,bmx*XZ2-x+XO1,bmy*YZ2-y+YO1,bm[])
Box(x+XO,bmy*YZ2-y+YO,x+XO1,bmy*YZ2-y+YO1,bm[])
#endif
Box(x+XO,y+YO,x+XO1,y+YO1,bm[]++)
ENDFOR
ENDFOR
ENDPROC
PROC setupsim()
DEF a,bm,b
bmt:=bmx*bmy
hinum:=0
iterations:=0
NEW bmp[bmnum]
NEW bmcalc[bmnum]
NEW bmscore[bmnum]
FOR a:=0 TO bmnum-1
bmp[a]:=bm:=FastNew(bmt)
FOR b:=0 TO bmt-1 DO bm[]++:=Rnd(COL)
ENDFOR
ENDPROC
PROC deallocsim()
DEF a
IF bmp THEN FOR a:=0 TO bmnum-1 DO IF bmp[a] THEN FastDispose(bmp[a],bmt)
END bmp[bmnum]
END bmcalc[bmnum]
END bmscore[bmnum]
ENDPROC
CONST MINSTART=$7FFFFFFF
PROC dosim()
DEF a,b,min,minnum
iterations++
FOR a:=0 TO bmnum-1 -> make sure all are rated
IF bmcalc[a]=FALSE
mutate(bmp[a])
bmscore[a]:=rate(bmp[a]) -> mutate and rerate if necessary
IF bmscore[a]>bmscore[hinum] THEN hinum:=a -> keep track of best
bmcalc[a]:=TRUE
ENDIF
ENDFOR
FOR a:=1 TO evrate -> pick n victims
min:=MINSTART
FOR b:=0 TO bmnum-1
IF (bmcalc[b]) AND b<>hinum
IF bmscore[b]<min -> calc worst
min:=bmscore[b]
minnum:=b
ENDIF
ENDIF
ENDFOR
IF min=MINSTART THEN Raise("prob")
bmcalc[minnum]:=FALSE
CopyMem(bmp[hinum],bmp[minnum],bmt) -> copy from best
ENDFOR
ENDPROC
PROC mutate(bm)
DEF a
FOR a:=1 TO nummut DO bm[Rnd(bmt)]:=Rnd(COL)
ENDPROC
PROC rate(bma) -> B: mixed environ
DEF a,c=0,tc,nc,bm
bm:=bma
FOR a:=0 TO bmt-1
tc:=bm[]
nc:=0
IF bm[-1]=tc THEN nc++
IF bm[1]=tc THEN nc++
IF bm[bmx]=tc THEN nc++
IF bm[bmx-1]=tc THEN nc++
IF bm[bmx+1]=tc THEN nc++
IF bm[-bmx]=tc THEN nc++
IF bm[-bmx-1]=tc THEN nc++
IF bm[-bmx+1]=tc THEN nc++
c:=c+(6-Abs(nc-2))
bm++
ENDFOR
ENDPROC c